home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0195.ZIP / DISKMOD.PAS < prev    next >
Pascal/Delphi Source File  |  1984-12-21  |  13KB  |  365 lines
  1. {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
  2. The purchaser of these procedures and functions may include them in COMPILED
  3. programs freely, but may not sell or give away the source text.
  4.  
  5.     This is a fancy demonstration of the procedure GetSector, contained
  6.     in the $INCLUDE file GETSECTR.LIB.  It is modeled on a BASIC program
  7.     called DISKMODF, by John VanderGrift.
  8.         GetSector simply reads the specified sector from the disk into
  9.     your buffer.  In this program, the buffer is just an array of bytes,
  10.     but you could declare the buffer to be an array of records of the
  11.     same "shape" as a directory entry--that would be one way to get
  12.     directory info from the disk.
  13.  
  14.     You may want to select SIDE 0, TRACK 0, SECTOR 6 --this is where the
  15.     directory begins.  Use the arrow keys to move around in the sector,
  16.     PgUp and PgDn to change sectors.  If you type alphanumeric keys, or
  17.     the special characters produced by <Alt><number>, the sector buffer
  18.     will be changed.  Then if you press F1, the changes will be written
  19.     to disk.
  20.  
  21.          NOTE that chr(3) and chr(27) cannot be treated like the other
  22.     characters.  Chr(3) is <Ctrl><Break>, and it will halt the program
  23.     if you try to enter Alt-3.  F9 has been set up to safely input chr(3).
  24.     Since <Esc> is the signal to QUIT, chr(27) is also unavailable as
  25.     itself -- F10 has been set up for it.
  26.  
  27.          This is not a refined program--you may want to experiment on a
  28.     copy.  Try renaming a file by changing its name in the directory
  29.     sector.
  30.  
  31. }
  32.  
  33. program DiskModify;
  34. type
  35.   HexByte = string[2];
  36. var
  37.   Buffer             : array[0..511] of byte;
  38.   HX                 :  array[0..255] of HexByte;
  39.   AS                 :  array[0..255] of char;
  40.   drive, YorN, sides : char;
  41.   sector, track, side,
  42.   maxSides, MaxSectors  : byte;
  43.   TByte                 : integer;
  44.   didRead               : boolean;
  45.  
  46. {$I regpack.typ}
  47. {$I disktyp.lib}
  48. {$I getsectr.lib}
  49. {$I monitor.lib}
  50. {$I screen.lib}
  51. {$I getkeys.lib}
  52.  
  53. {OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
  54. procedure ByteAtt(WhichByte : integer; attribute:byte);
  55. var
  56.   col, row : byte;
  57. begin
  58.   row := (WhichByte div 24) + 2;               { This procedure lights }
  59.   col := (WhichByte mod 24);                   { up the locations on   }
  60.   ScreenAttribute(col*2+1, row, attribute);    { the screen that go    }
  61.   ScreenAttribute(col*2+2, row, attribute);    { with the byte being   }
  62.   ScreenAttribute(col + 51, row, attribute);   { pointed at in the     }
  63. end;                                           { buffer.               }
  64. {OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
  65. procedure initialize;
  66. var
  67.   N, temp : byte;
  68. begin
  69.   CheckColor;
  70.   for N := 0 to 255 do
  71.     begin
  72.       case N of
  73.         7..13 : AS[N] := chr(N + 64);      { The array AS consists of    }
  74.            28 : AS[N] := '\';              { a PRINTABLE character for   }
  75.            29 : AS[N] := ']';              { each byte 0 to 255.  Some   }
  76.            30 : AS[N] := chr(24);          { of the characters are not   }
  77.            31 : AS[N] := chr(25);          { normally printable, because }
  78.       else      AS[N] := chr(N);           { they change the display     }
  79.       end;  {case}
  80.       HX[N] := '00';
  81.       temp := N mod 16;
  82.       if temp <= 9 then HX[N][2] := chr(temp + 48)    { I use an array here }
  83.                    else HX[N][2] := chr(temp + 55);   { rather than making  }
  84.       temp := N div 16;                               { a function in order }
  85.       if temp <= 9 then HX[N][1] := chr(temp + 48)    { to save calculation }
  86.                    else HX[N][1] := chr(temp + 55);   { time.               }
  87.     end;   {for N}
  88.   DidRead := false;
  89. end;
  90. {OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
  91. procedure choices;
  92.    {ooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
  93.    procedure selections;
  94.    var
  95.      okay : boolean;
  96.      begin
  97.        repeat
  98.          Write('Select drive: '); read(drive)
  99.          until UpCase(drive) in ['A'..'D'];
  100.          GotoXY(1,4);
  101.          case DiskType(drive) of
  102.            160: begin
  103.                   maxSides := 1;
  104.                   MaxSectors  := 8;
  105.                   Write('Single');
  106.                 end;
  107.            180: begin
  108.                   maxSides := 1;
  109.                   MaxSectors  := 9;
  110.                   Write('Single');
  111.                 end;
  112.            320: begin
  113.                   MaxSides := 2;
  114.                   MaxSectors  := 8;
  115.                   write('Double');
  116.                 end;
  117.            360: begin
  118.                   maxSides := 2;
  119.                   MaxSectors  := 9;
  120.                   write('Double');
  121.                 end;
  122.            else
  123.              WriteLn('Wierd disk.  Can''t deal with it!');
  124.              halt;
  125.            end;
  126.        Write('-sided, ',MaxSectors,' sectors.');
  127.        GotoXY(1,6);
  128.        WriteLn('Select track (0-39)');
  129.        WriteLn('Select sector (1-',MaxSectors:1,')');
  130.        if maxSides = 2 then
  131.        WriteLn('Select side   (0-1)');
  132.        repeat
  133.          GotoXY(22,6); read(track);
  134.          until track in [0..39];
  135.        repeat
  136.          GotoXY(22,7);  read(sector);
  137.          until sector in [1..MaxSectors];
  138.        if maxSides = 2 then
  139.          repeat
  140.            GotoXY(22,8);  read(side);
  141.            until side in [0..1]
  142.          else side := 0;
  143.       end;
  144.    {ooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
  145. begin
  146.   repeat
  147.     ClrScr;
  148.     Selections;
  149.     gotoXY(22,10);
  150.     Write('Selections OK? ');read(YorN);
  151.   until UpCase(YorN) = 'Y';
  152. end;
  153. {OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
  154. procedure BigShow;
  155. var
  156.   N : integer;
  157.   col, row : byte;
  158. begin
  159.   if DidRead then
  160.     begin
  161.       ClrScr;
  162.       Write('Drive: ',drive,'  Side: ',side,'  Track: ',track);
  163.       WriteLn('        Sector: ',Sector,'   Byte: ',TByte);
  164.       for N := 0 to 511 do
  165.         begin
  166.           row := (N div 24) + 2;
  167.           col := (N mod 24);
  168.           GotoXY(2*col+1,row);
  169.           write(HX[buffer[N]]);
  170.           GotoXY(col + 51,row);
  171.           Write(AS[buffer[N]]);
  172.         end;
  173.       GotoXY(17,23); write('                                ');
  174.       GotoXY(59,23); write('                ');
  175.       TextColor(blue);  {blue = underline in monochrome}
  176.       GotoXY(1,24); write('  F1 to modify disk. <Esc> to quit.');
  177.       TextColor(white);
  178.     end;
  179. end;
  180. {OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
  181. procedure ShowChar;
  182. var
  183.   TheChar : byte;
  184. begin
  185.   GotoXY(54,1);
  186.   ClrEOL;
  187.   write(TByte);
  188.   TheChar := buffer[TByte];
  189.   GotoXY(45,24);
  190.   ClrEOL;
  191.   TextColor(black);TextBackGround(white);
  192.   write(HX[TheChar],' ',chr(TheChar),' ');
  193.   TextColor(white);TextBackGround(black);
  194. end;
  195. {OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
  196. procedure TakeInstructions;
  197. var
  198.   doit, choice, EscChoice : char;
  199.   {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
  200.    procedure increment(var Trak, Sek, Sid: byte);
  201.    begin
  202.      if maxSides = 1 then
  203.        begin                              { The procedures "increment" }
  204.          Sek := Sek + 1;                  { and "decrement" just take  }
  205.          if Sek > MaxSectors then         { the IBM disk format ORDER  }
  206.            begin                          { and codify it.  It turns   }
  207.              Sek := 1;                    { out to be rather compli-   }
  208.              Trak := Trak + 1;            { cated!                     }
  209.              if Trak > 39 then Trak := 0;
  210.            end;
  211.        end
  212.      else
  213.        begin
  214.          Sek := Sek + 1;
  215.          if Sek > MaxSectors then
  216.            begin
  217.              Sek := 1;
  218.              if Sid = 0 then Sid := 1
  219.                else
  220.                  begin
  221.                    Sid := 0;
  222.                    Trak := Trak + 1;
  223.                    if Trak > 39 then Trak := 0;
  224.                  end;
  225.            end;
  226.        end;
  227.   end;
  228.   {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
  229.    procedure decrement(var Trak, Sek, Sid: byte);
  230.    begin
  231.      if maxSides = 1 then
  232.        begin
  233.          Sek := Sek - 1;
  234.          if Sek < 1 then
  235.            begin
  236.              Sek := MaxSectors;
  237.              Trak := Trak - 1;
  238.              if Trak < 0 then Trak := 39;
  239.            end;
  240.        end
  241.      else
  242.        begin
  243.          Sek := Sek - 1;
  244.          if Sek < 1 then
  245.            begin
  246.              Sek := MaxSectors;
  247.              if Sid = 1 then Sid := 0
  248.                else
  249.                  begin
  250.                    Sid := 1;
  251.                    Trak := Trak - 1;
  252.                    if Trak < 0 then Trak := 39;
  253.                  end;
  254.            end;
  255.        end;
  256.   end;
  257.   {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
  258.     procedure Advance;
  259.       begin
  260.         if TByte < 511 then
  261.           begin
  262.             ByteAtt(TByte,15);
  263.             TByte := TByte + 1;
  264.             ByteAtt(Tbyte,112);
  265.             ShowChar;
  266.           end;
  267.       end;
  268.   {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
  269.     procedure NewChar(ch : char);
  270.       begin
  271.         WriteScreen(48,24,ch,112);
  272.         Buffer[TByte] := ord(ch);
  273.         WriteScreen((TByte mod 24) + 51, (TByte div 24)+2,ch,112);
  274.         TextColor(black);TextBackGround(white);
  275.         GotoXY(2*(TByte mod 24)+1,(TByte div 24) + 2);
  276.         write(HX[ord(ch)]);
  277.         TextColor(white);TextBackGround(black);
  278.       end;
  279.   {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
  280. begin                                { Wait 'til a key is pressed.  If it's  }
  281.   repeat                             { a "special" key, check what action to }
  282.     GetKeys(choice,EscChoice);       { take.  If it's "ordinary", insert its }
  283.     if choice = chr(27) then         { value in the buffer at the current    }
  284.       case EscChoice of              { place and display it.                 }
  285.         'I': {PgUp} begin
  286.                 decrement(track,sector,side);
  287.                 GetSector('R',drive,side,sector,track,didRead);
  288.                 TByte := 0;
  289.                 Bigshow;
  290.                 ShowChar;
  291.                 byteAtt(TByte,112);
  292.              end;
  293.         'Q': {PgDn}  begin
  294.                 increment(track,sector,side);
  295.                 GetSector('R',drive,side,sector,track,didRead);
  296.                 TByte := 0;
  297.                 Bigshow;
  298.                 ShowChar;
  299.                 byteAtt(TByte,112);
  300.              end;
  301.         'O': { end};
  302.         'H': if (TByte div 24) > 0 then
  303.                begin
  304.                  ByteAtt(TByte,15);
  305.                  TByte := TByte - 24;
  306.                  ByteAtt(Tbyte,112);
  307.                  ShowChar;
  308.                end;
  309.         'P': if TByte < 488 then
  310.                begin
  311.                  ByteAtt(TByte,15);
  312.                  TByte := TByte + 24;
  313.                  ByteAtt(Tbyte,112);
  314.                  ShowChar;
  315.                end;
  316.         'K': if TByte > 0 then
  317.                begin
  318.                  ByteAtt(TByte,15);
  319.                  TByte := TByte - 1;
  320.                  ByteAtt(Tbyte,112);
  321.                  ShowChar;
  322.                end;
  323.         'M': Advance;
  324.         ';': begin
  325.                GotoXY(1,24); ClrEOL;
  326.                WRite('Are you sure you want to change the disk? ');
  327.                read(doit);
  328.                if UpCase(doit) = 'Y' then
  329.                   GetSector('W',drive,side,sector,track,didRead);
  330.                GotoXY(1,24); ClrEOL;
  331.                TextColor(blue);
  332.                Write('  F1 to modify disk. <Esc> to quit.');
  333.                TextColor(black);
  334.              end;
  335.         'C': begin             { Use F9 to enter a chr(3).  Chr(3) }
  336.                newChar(#3);    { is equivalent to <Ctrl><Break>,   }
  337.                Advance;        { so you can't enter it normally.   }
  338.              end;
  339.         'D': begin             { Use F10 to enter a chr(27) (<Esc>). }
  340.                newChar(#27);   { Can't enter it directly OR thru the }
  341.                Advance;        { Alt-# combination -- it's the QUIT  }
  342.              end;              { signal, and it works.               }
  343.       end { case}
  344.     else
  345.       begin
  346.         newChar(choice);
  347.  
  348.         Advance;
  349.       end;
  350.   until (choice = chr(27)) and (EscChoice = #0);
  351. end;
  352. {OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
  353. begin
  354.   initialize;
  355.   choices;
  356.   GetSector('R',drive,side,sector,track,didRead);
  357.   TByte := 0;
  358.   BigShow;
  359.   ShowChar;
  360.   ByteAtt(Tbyte,112);
  361.   TakeInstructions;
  362.   ClrScr;
  363. end.
  364.  
  365.